home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / rts / util.scm < prev    next >
Text File  |  1995-10-13  |  2KB  |  68 lines
  1. ; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
  2. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  3.  
  4.  
  5. ; This is file util.scm.
  6.  
  7. ;;;; Utilities
  8.  
  9. (define (unspecific) (if #f #f))
  10.  
  11. (define (reduce cons nil list)        ;used by length, append, etc.
  12.   (if (null? list)
  13.       nil
  14.       (cons (car list) (reduce cons nil (cdr list)))))
  15.  
  16. (define (filter pred lst)
  17.   (reduce (lambda (x rest)
  18.         (if (pred x) (cons x rest) rest))
  19.       '()
  20.       lst))
  21.  
  22. ; Position of an object within a list
  23.  
  24. (define (pos pred)
  25.   (lambda (thing l)
  26.     (let loop ((i 0) (l l))
  27.       (cond ((null? l) #f)
  28.         ((pred thing (car l)) i)
  29.         (else (loop (+ i 1) (cdr l)))))))
  30.  
  31. (define posq (pos eq?))
  32. (define posv (pos eqv?))
  33. (define position (pos equal?))
  34.  
  35. ; Is pred true of any element of l?
  36.  
  37. (define (any pred l)
  38.   ;; (reduce or #f l), sort of
  39.   (if (null? l)
  40.       #f
  41.       (or (pred (car l)) (any pred (cdr l)))))
  42.  
  43. ; Is pred true of every element of l?
  44.  
  45. (define (every pred l)
  46.   ;; (reduce and #t l), sort of
  47.   (if (null? l)
  48.       #t
  49.       (and (pred (car l)) (every pred (cdr l)))))
  50.  
  51. (define (sublist l start end)
  52.   (if (> start 0)
  53.       (sublist (cdr l) (- start 1) (- end 1))
  54.       (let recur ((l l) (end end))
  55.     (if (= end 0)
  56.         '()
  57.         (cons (car l) (recur (cdr l) (- end 1)))))))
  58.  
  59. (define (last x)
  60.   (if (null? (cdr x))
  61.       (car x)
  62.       (last (cdr x))))
  63.  
  64. (define (insert x l <)
  65.   (cond ((null? l) (list x))
  66.         ((< x (car l)) (cons x l))
  67.         (else (cons (car l) (insert x (cdr l) <)))))
  68.